home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / langwn23.zip / SAMPLE04.BAS < prev    next >
BASIC Source File  |  1993-03-20  |  53KB  |  1,422 lines
  1. ' giving your user a set of scrollable lists, with files and
  2. ' sub-directories that can be selected, is a common GUI technique.
  3. ' SAMPLE04.BAS shows how to use LangWin to achieve this effect.
  4.  
  5. ' a mode 4 (wallpaper) window is used as background.
  6. ' several unmovable windows (of the same
  7. ' color as background window) with no shadows,
  8. ' are created to provide several
  9. ' scrollable lists in "one" window.
  10.  
  11. ' the directory and file access routines are used to create
  12. ' scrollable lists of files and sub-directories. by clicking
  13. ' on a sub-directory, you can change into it, and it's contents
  14. ' (files and directories) will then be displayed in the scrollable
  15. ' lists.
  16.  
  17. ' this sample also shows how to use an error recovery routine
  18. ' in the main module to detect when a drive is not ready,
  19. ' and allow the user to retry or quit the operation.
  20.  
  21. ' subroutine DoFiles (which also calls ChgPath and SortIt) is
  22. ' meant to be a stand-alone routine that you can copy and use
  23. ' in your own programs. it implements techniques to create
  24. ' a "menu" with drives, sub-directories, files, and the current directory.
  25. ' these can be scrolled, selected, and/or changed.
  26.  
  27.  
  28. DECLARE FUNCTION ChgPath% (NewPath$)   ' changes to new path
  29. DECLARE SUB DoFiles ()                 ' menu of files, dirs, drives
  30. DECLARE SUB SortIt (s$())              ' bubble sort
  31. DECLARE SUB Main ()                    ' main window
  32. DECLARE FUNCTION VidType% ()           ' gets type of monitor
  33. DECLARE SUB ProcessFiles (Qual$, Text$())  ' sample routine to process files
  34.  
  35. '  must compile with qb /ah /L langwin
  36.  
  37. '$DYNAMIC  make all arrays dynamic
  38.  
  39. DEFINT A-Z
  40.  
  41. '$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin.
  42. '                         NOTE: LANGWIN.BI contains all definitions found
  43. '                               in QB.BI, so include for QB.BI is not needed.
  44.  
  45.  
  46.  
  47. CLEAR , , 5000   ' set stack at 5000 bytes
  48.  
  49.  
  50. '---------------------------------------------------------------
  51. ' first see if EGA or VGA monitor
  52. mm = VidType
  53. IF mm <> 3 AND mm <> 4 THEN
  54.     BEEP
  55.     PRINT
  56.     PRINT "LangWin's GUI only supports EGA and VGA."
  57.     PRINT
  58.     END
  59. END IF
  60.  
  61. '----------------------------------------------------------------
  62. ' SHARED VARIABLES
  63.  
  64. ' - dlett$:  MUST contain the letter of the drive that is being
  65. '       referenced by the GetCurDir$ function.
  66. '       if the drive is not ready, the error routine in the main module will
  67. '       get control and use dlett$ in its error message.
  68. ' - ignor: used a flag for the error routine. when a drive is selected but
  69. '       not ready, the error routine gets control and opens a window that
  70. '       contains a RETRY button and possinly an IGNORE button.
  71. '       if ignor=0 then IGNORE button is NOT displayed; else it is displayed.
  72. '       selecting RETRY will cause the instruction that generated the
  73. '       "not ready" error to be retried. selecting IGNORE will pass control
  74. '       to the instruction after the one generating the error condition.
  75. ' - Ldrives: number of logical drives on the system
  76. ' - OneFlop: flag set (TRUE) if system has one floppy, else FALSE
  77.  
  78.  
  79. DIM SHARED dlett$, ignor, Ldrives, OneFlop
  80. '-----------------------------------------------------------------
  81.  
  82.  
  83. ON ERROR GOTO ErrorTrap    ' enable error routine
  84.  
  85. '-----------------------------------------------------------------
  86. ' get attribute from current screen so it can be restored upon exit
  87. OrigAttr = SCREEN(1, 1, 1)' save original attribute from row 1, col 1
  88.  
  89. '-------------------------------------------------------------------
  90. ' if WIDTH command is used, it must be placed before call to LangWinInit
  91. ' because code in LangWinInit extracts max rows/cols from screen and saves
  92. ' in global variables.
  93. WIDTH 80, 25
  94.  
  95. '----------------------------------------------------------------------
  96. ' these variables MUST be defined BEFORE call to LangWinInit.
  97. ' keep these as low as possible to conserve memory at run time.
  98. MaxWindows = 10       ' max simultaneous open windows
  99. MaxButtons = 40      ' max number of objects (including text labels) active
  100. MaxTextLines = 200   ' maximum number of text lines in any scrollable win
  101. MaxTextWins = 4      ' max windows that can have scrollable text
  102.                      ' must be <= MaxWindows
  103.  
  104. LOCATE , , 0         ' start with hidden text cursor
  105.  
  106. SCREEN 0, , 0, 0     ' text mode
  107.  
  108. CALL LangWinInit     ' initialize (if mouse exists, it will be displayed)
  109.                
  110.                      ' if you get "subscript out of range" error while
  111.                      ' in this routine, be sure you called QB with /ah.
  112.                      ' then try reducing the value of MaxWindows.
  113.                      ' check the WIDTH command; reduce number of columns,
  114.                      ' and/or number of rows.
  115.  
  116. '---------------------------------------------------------------------
  117. ' get actual number of logical drives on the system
  118.  
  119. ' get # drives from ChangeDrive (i.e., int 21h, function 0Eh).
  120. ' value will be max of 5 or # logical drives specified
  121. ' in LASTDRIVE parm in config.sys (i.e., LASTDRIVE=c will cause ChangeDrive
  122. ' to return 5, not 3, as # logical drives - that's a DOS quirk, not mine).
  123. ' LASTDRIVE=g will cause ChangeDrive to return a 7.
  124.  
  125. ' drives specified in LASTDRIVE parm, however, might not be actual
  126. ' number of drives on system (LASTDRIVE=z doesn't mean you have 26 drives)
  127. ' so, after we get LASTDRIVES value, we must determine how many logical
  128. ' drives really exist (without attempting to read from them
  129. ' which could produce a drive not ready error) - that is, we need to know
  130. ' how many drives are actually configured on the system, not how many
  131. ' are ready at this moment.
  132.  
  133. dd$ = GetCurDrive$         ' current default drive
  134. Ldrives = ChangeDrive(dd$) 'get LASTDRIVES value
  135.  
  136. ' now see how many drives are actually there
  137. ' step through each drive (starting with #1) and try to
  138. ' change to it with ChangeDrive. if successful, continue with loop.
  139. ' if unsuccessful, then previous drive was last drive on the system.
  140.  
  141. FOR i = 1 TO Ldrives
  142.     dl$ = CHR$(ASC("A") - 1 + i)   ' compute a drive letter
  143.     x = ChangeDrive(dl$)           ' try to change to it
  144.     IF x < 0 THEN                  ' successful?
  145.         Ldrives = i - 1   ' can't change to drive i, change value of ldrives
  146.         EXIT FOR          ' stop scan
  147.     END IF
  148. NEXT
  149. x = ChangeDrive(dd$) ' now change back to original drive
  150.  
  151. '--------------------------------------------------------------------
  152. ' on systems with only one physical floppy drive, it can be logically
  153. ' referenced as both A: and B: (dos handles this).
  154. ' however, if the A: drive is "active" and you try and access the B: drive,
  155. ' dos will display the following message:
  156. '    "Insert diskett for drive B: and press any key when ready"
  157. ' unfortunately, you cannot control the placement of this message and it will
  158. ' ruin an otherwise attractive display of windows.
  159.  
  160. ' if the system has one floppy, and either A: or B: is selected by user,
  161. ' i assume that both drive letters refer to the same physical drive,
  162. ' and i first make the appropriate logical letter "active" before the
  163. ' drive is accessed. this should avoid the dos message.
  164. ' a not ready condition will be detected, and an error window opened,
  165. ' if the A: or B: drive (which has been made active) is not ready
  166. ' (i.e., does not have a floppy inserted and the door closed).
  167.  
  168. ' the byte at &H504 is used to make either A: or B: active.
  169. ' if it is set to 0, then A: is active; if 1 then B: is active
  170. ' (assuming that there is only one floppy on the system).
  171. ' the word at &H410 contains info on system equipment.
  172. ' if bit 0 is set, then the system has floppies.
  173. ' in that case, bits 6 & 7 indicate the number of floppies minus 1
  174. ' (i.e., if bits 6 & 7 are 0, then system has 1 floppy drive).
  175.  
  176. ' first, lets see if this system has only one floppy drive
  177. OneFlop = FALSE     ' default for flag
  178. DEF SEG = 0         ' establish addressability to low memory
  179. IF (PEEK(&H410) AND &H1) = 1 THEN   ' test bit 0 to see if any floppies
  180.     ' floppies exist, see how many
  181.     ' set flag if only one
  182.     IF (PEEK(&H410) AND &HC0) = 0 THEN OneFlop = TRUE
  183. END IF
  184. DEF SEG              ' restore addressability
  185.  
  186. ' the OneFlop flag will be used later (when a disk is selected)
  187. ' to determine if there's only one drive on the system,
  188. ' if only one floppy drive and either A: or B: is selected, then the
  189. ' corresponding logical drive must first made "active" (via byte at &H504)
  190. ' BEFORE any I/O is attempted on that drive. this will avoid DOS detecting
  191. ' that activity was attempted on an "inactive" logical drive and displaying
  192. ' the dreaded "insert diskett" message right in the middle
  193. ' of an otherwise nice looking display.
  194.  
  195. ' if your system has only one
  196. ' floppy, and you want to see the effect of this DOS
  197. ' message, just set OneFlop=FALSE below this comment,
  198. ' and select the B: drive.
  199.  
  200.  
  201. '-----------------------------------------------------------------------
  202. ' display "wallpaper"
  203.  
  204. IF HaveMouse THEN CALL HideMouseCursor  ' first hide mouse pointer
  205.  
  206. CLS
  207. CALL SetColor(8, 15)
  208. FOR i = 1 TO MaxRows
  209. LOCATE i, 1
  210. PRINT STRING$(80, 178);     ' can try 176, 177, or 178
  211. NEXT
  212.  
  213.  
  214. IF HaveMouse THEN CALL ShowMouseCursor   ' display the mouse pointer
  215.  
  216. '==============================================================
  217.  
  218. CALL Main
  219.  
  220. '=====================================================================
  221.  
  222.  
  223. IF HaveMouse THEN HideMouseCursor    ' we're done with the mouse
  224.  
  225. bbb = (OrigAttr AND &HF0) \ 16  ' mask & shift to get original background
  226. fff = OrigAttr AND &HF          ' mask to get original foreground
  227.  
  228.  
  229. PALETTE                           ' restore original palette
  230. CALL SetColor(fff, bbb)           ' restore orig foreground/background
  231. CLS
  232. LOCATE , , 1                      ' make text cursor visible
  233.  
  234. END
  235.  
  236. '=============================================================
  237. ' error routine - when drive not ready, will open win with message
  238. '               - if file to be deleted, will set flag and return error #
  239.  
  240. ErrorTrap:
  241.  
  242. SELECT CASE ERR   ' determine which error occured
  243.  
  244.     CASE 71   ' drive not ready
  245.        
  246.         ' dlett$ MUST be SHARED and contain the letter of the drive that
  247.         ' is being referenced by the GetCurDir$ function.
  248.         ' ignor MUST be SHARED and is used a flag.
  249.         ' if ignor=0 then IGNORE button is NOT displayed; else it is displayed.
  250.        
  251.         BEEP
  252.       
  253.         ' open modal window with no close button
  254.         nr = BlankWin(16, 1, 23, 31, 4, 15, 1, 15, 0, 2)
  255.         x = ShowWinText(2, 4, 15, "DRIVE " + UCASE$(dlett$) + ": NOT READY!")
  256.         r1 = MakePushButton(4, 4, 7, "RETRY", 15, 3, 1)
  257.         IF ignor <> 0 THEN q1 = MakePushButton(4, 19, 8, "IGNORE", 15, 3, 1)
  258.         ' wait for a button press
  259.         DO
  260.             wn = WinEvent(action)' wait for an event
  261.             ' since error window was modal, it's the only one
  262.             ' that can return events. no need to test for window number
  263.             IF action = 3 THEN ' button press?
  264.                 button = WinParms(CurWinPtr, 16)
  265.                 x = CloseWindow
  266.                 SELECT CASE button' which button?
  267.                 CASE r1   ' retry
  268.                     RESUME
  269.                 CASE q1   ' ignore
  270.                     RESUME NEXT
  271.                 END SELECT
  272.             END IF
  273.         LOOP
  274.       
  275.     CASE ELSE  ' any other error
  276.         ON ERROR GOTO 0   ' display the error
  277. END SELECT
  278.  
  279.  
  280.  
  281. END
  282.  
  283. REM $STATIC
  284. FUNCTION ChgPath (NewPath$)
  285.  
  286. '  change path function
  287.  
  288. '  INPUT:
  289. '    NewPath$:      path to change to (can contain drive and directory)
  290.  
  291. '  OUTPUT:
  292. '    0:             change was successful
  293. '   -1:             invalid drive letter
  294. '   -2:             drive not ready - current
  295. '   -3:             drive not ready - spec in NewPath$
  296. '   -4:             invalid dir name or could not change to dir
  297.  
  298. dlett$ = GetCurDrive$   ' save drive letter (get current drive).
  299.                         ' GetCurDrive$ will not do i/o to disk,
  300.                         ' thus it will not detect drive not ready
  301.                         ' (returns upper case value)
  302.           
  303. ' if 2nd char in input field is colon (:),
  304. ' then assume first is a drive letter.
  305. ' get it (cvt to UCASE) and save in dlett$.
  306. IF MID$(NewPath$, 2, 1) = ":" THEN
  307.     orglett$ = (LEFT$(NewPath$, 1))  ' extract letter
  308.     dlett$ = UCASE$(orglett$)   ' convert to UCASE
  309. END IF
  310.           
  311. ' at this point, dlett$ has current drive letter (if NewPath$ did not
  312. ' specify a drive), or it has the drive letter specified in NewPath$
  313.  
  314. x = ASC(dlett$)   ' get ascii value of the letter
  315.  
  316. ' see if drive "letter" was valid and within range of real drives
  317. ' (the global variable Ldrives is defined in main module)
  318. IF x < ASC("A") OR x > ASC("A") - 1 + Ldrives THEN
  319.     ' drive "letter" was NOT valid
  320.     ' either it was not a letter, or not a real drive on system
  321.     ' open modal window with error msg
  322.     BEEP
  323.     y = BlankWin(9, 1, 16, 37, 4, 15, 1, 15, 0, 2)
  324.     y = ShowWinText(2, 2, 15, "Invalid drive letter specified: " + orglett$)
  325.     y = MakePushButton(4, 7, 4, "OK", 15, 3, 1)
  326.     y = WinEvent(z)    ' wait for any event
  327.     y = CloseWindow
  328.     ChgPath = -1       ' return code
  329.     EXIT FUNCTION      ' bail out
  330. END IF
  331.  
  332. ' drive letter was valid
  333.        
  334. ' if system has only one floppy, and either A: or B: was selected,
  335. ' make that logical drive active to avoid the dos "insert diskette"
  336. ' message when attempting to do I/O to an inactive logical floppy.
  337. ' (OneFlop global variable is defined in the main module).
  338.  
  339. IF OneFlop THEN      ' only one floppy on system?
  340.     IF dlett$ = "A" THEN    ' was A: selected ?
  341.         DEF SEG = 0
  342.         flopsav = PEEK(&H504)  ' save original
  343.         POKE &H504, 0       ' set A: active
  344.         DEF SEG
  345.     ELSEIF dlett$ = "B" THEN  ' else was b: selected ?
  346.         DEF SEG = 0
  347.         flopsav = PEEK(&H504)  ' save original
  348.         POKE &H504, 1        ' set B: active
  349.         DEF SEG
  350.     END IF
  351. END IF
  352.  
  353. ' change to new dir
  354. ignor = 1    ' flag to display IGNORE button if drive not ready
  355. x = 1234     ' init x to a value never returned by ChangeDir
  356. x = ChangeDir(NewPath$)  ' change to specified directory
  357. ' ChangeDir() will cause i/o to defualt drive.
  358. ' not ready condition will be detected and processed by error
  359. ' routine in main module. if IGNORE selected, x will remain set
  360. ' to 1234.
  361. ignor = 0    ' reset flag
  362.                    
  363. ' lets see if drive was not ready and user selected ignore
  364. IF x = 1234 THEN
  365.     ' drive is not ready
  366.     ' if single floppy system & drive A/B was selected, reset active floppy
  367.     ' back to original state
  368.     IF OneFlop AND (dlett$ = "A" OR dlett$ = "B") THEN
  369.         DEF SEG = 0
  370.         POKE &H504, flopsav  ' restore orig value
  371.         DEF SEG
  372.     END IF
  373.                 
  374.     ' see if it was the current drive or some other (in NewPath$) not ready
  375.     IF dlett$ = GetCurDrive$ THEN
  376.        ' the current drive is not ready
  377.        ChgPath = -2      ' set return code
  378.     ELSE
  379.        ' drive specified in NewPath$ was not ready (it was not current drive)
  380.        ChgPath = -3      ' set return code
  381.     END IF
  382.     EXIT FUNCTION        ' bail out
  383.  
  384. ' drive was ready (or made ready). see if ChangeDir was ok
  385. ELSEIF x < 0 THEN
  386.     'could not change to dir specified
  387.     ' open modal window with no close icon
  388.     BEEP
  389.     y = BlankWin(9, 1, 16, 37, 4, 15, 1, 15, 0, 2)
  390.     ' display message with reason
  391.     IF x = -1 THEN
  392.            y = ShowWinText(2, 2, 15, "Invalid dir name specified")
  393.     ELSE
  394.            y = ShowWinText(2, 2, 15, "Could not change dir")
  395.     END IF
  396.     y = MakePushButton(4, 7, 4, "OK", 15, 3, 1)
  397.     y = WinEvent(z)  ' wait for any event
  398.     y = CloseWindow
  399.     ChgPath = -4     ' set return code
  400.     EXIT FUNCTION    ' bail out
  401.  
  402. ELSE
  403.     ' change to new dir  was ok,
  404.     ' change default drive (we know its ok and ready)
  405.     x = ChangeDrive(dlett$)' change to new drive
  406.     IF x < 0 THEN END ' error not likely since prev ChangDir was ok
  407. END IF ' end of code to test for error in ChangeDir
  408.  
  409. ChgPath = 0      ' successful return code
  410.  
  411. END FUNCTION
  412.  
  413. SUB DoFiles
  414.  
  415. ' this subroutine can be copied and used in your own programs
  416. ' (don't forget that it calls ChgPath and SortIt).
  417.  
  418. ' DoFiles creates a "menu" with
  419. ' drives, sub-directories, files, and the current path.
  420. ' these can be scrolled, selected and/or changed.
  421. ' it uses the following LangWin functions:
  422.  
  423. '   GetCurDrive$     get the current drive's letter
  424. '   ChangeDrive      change the current drive
  425. '   GetCurDir$       get the current dir's name
  426. '   ChangeDir        change the current dir
  427. '   GetFileNames     get names of files in current drive:dir
  428.  
  429. ' just click on the dir or drive you want to change to.
  430. ' the files in that directory will be displayed.
  431. ' click on file name to select it. click on GO to see a list
  432. ' of all file names selected (in practice, your code would do something
  433. ' with this list; like move, copy, delete, etc).
  434. '
  435. ' the code in this routine could easily be modified to display
  436. ' an input field where the user could enter a file spec.
  437. ' you could use this file spec in the calls
  438. ' to GetFileNames(2, "*.*", Text$()) instead of the "*.*" parameter.
  439. ' in that way, only selected files matching the file spec would be displayed.
  440. ' i'll leave this modification as an exercise to the reader.
  441.  
  442. ' this subroutine actually opens 4 separate windows, one each for
  443. ' drives, sub-directories, files, and current path. all windows use
  444. ' the same color scheme, and are placed over a window with "wallpaper" mode
  445. ' to give the illusion that there's really only one "menu" with multiple
  446. ' sections (when actually, 4 separate windows are displayed and used).
  447.  
  448. ' therefore, we need to allow the mouse to select any of these 4 windows,
  449. ' but NOT any other underlying windows (which would then be made active and
  450. ' overlay part of "menu"). we can't make the 4 windows in the "menu" modal;
  451. ' that would prevent selection of objects in all but the active window.
  452.  
  453. ' so, PRIOR to calling this DoFiles, all other open windows must
  454. ' be manually set to mode 4 (wallpaper) and reset to their original mode upon
  455. ' return. by setting other windows to mode 4, clicks on these other windows
  456. ' will be ignored. the following shows sample code to do this. it assumes one
  457. ' window, whose number is saved in variable main1, is open (if multiple
  458. ' windows were open, this code could easily be modified to set the mode of
  459. ' all open windows to 4):
  460.             
  461.            
  462. '     ' this code would be placed in the main moudle prior to calling DoFiles
  463.  
  464. '     ' get handle of window whose number is main1, save in main1han
  465. '     ' (assume it's open at this point, no need to test return code)
  466. '     x = IsWinOpen(main1, main1han)
  467. '     zz = WinParms(main1han, 19)' save current mode of main1 win
  468. '     WinParms(main1han, 19) = 4  ' set mode of main1 win to wallpaper
  469. '     CALL DoFiles
  470. '     WinParms(main1han, 19) = zz   ' restore mode
  471.  
  472.  
  473.  
  474. '=================== INITIALIZATION ==========================
  475.  
  476.  
  477. ' get current disk letter and directory
  478. DefaultDisk$ = GetCurDrive$      ' get current drive letter
  479. dlett$ = DefaultDisk$            ' shared variable - used in error routine
  480. ignor = 1                        ' flag to display IGNORE button if not ready
  481. DefaultDir$ = "NOT READY"        ' default to specific string
  482. DefaultDir$ = GetCurDir$("")     ' get current dir (i/o to drive)
  483. ignor = 0                        ' reset flag
  484.  
  485. skip1 = FALSE    ' flag to skip display of all windows but drives
  486. IF DefaultDir$ = "NOT READY" THEN skip1 = TRUE  ' set skip flag if not ready
  487.  
  488.  
  489.  
  490. '---- BUILD THE MENU WITH DRIVES, SUB-DIRS, FILES, AND PATH -------
  491.  
  492. '====================== WALLPAPER =============================
  493.  
  494. ' first, place a "wallpaper" window on the screen.
  495. ' this window will have a shadow and be the foundation of the menu.
  496. ' other windows with same color will be placed over this wallpaper window
  497. ' to give the impression of one menu with multiple scrollable lists.
  498. ' these other windows will be shadowless and unmovable.
  499.  
  500. PALETTE 4, 57    ' temporarily set attrib 4 to 57 (9) to min visual impact
  501. wal = BlankWin(1, 10, 24, 46, -4, 1, 2, 15, 0, 4)
  502. x = ShowWinText(22, 10, 15, "Double Click Files")
  503. x = ShowWinText(23, 8, 15, " Then Click GO Button ")
  504.  
  505.  
  506. '====================== DISPLAY DRIVES ==================================
  507.  
  508. ' array to hold drive names (Ldrives was determined in main module)
  509. REDIM Text$(1 TO Ldrives)
  510.  
  511. ' for each drive on the system,
  512. ' make an array with drive letters in the form [-x-]
  513. FOR i = 1 TO Ldrives
  514.     Text$(i) = "[-" + CHR$(ASC("A") - 1 + i) + "-]"
  515. NEXT
  516.  
  517. ' open a window and display the drives
  518. ' i'll omit error checking since all parms are static
  519. ' i'll also assume that Ldrives < MaxTextLines (else all drive names will not
  520. '  be displayed in the scrollable list).
  521. drv = OpenScrollWindow(16, 33, 22, 46, -9, 15, 1, 15, Text$(), 2, 3, 5, 11, 0, -1)
  522. x = ShowTitle("DRIVES", 14, 9)
  523.                            
  524.  
  525.  
  526.  
  527. '======================== DISPLAY DIRECTORIES =========================
  528.  
  529. REDIM Text$(1 TO 1)  ' clear the array
  530.  
  531. IF NOT skip1 THEN   ' bypass if default drive not ready
  532.     GOSUB XtractSubDirs   ' go get sorted list of sub-dirs
  533. END IF   ' end bypass if not ready
  534.  
  535. ' open a window for the directories
  536. ' i'll omit error checking since all parms are static
  537. dirs = OpenScrollWindow(7, 33, 15, 46, -9, 15, 1, 15, Text$(), 2, 3, 7, 11, 0, -1)
  538. x = ShowTitle("DIRS", 14, 9)
  539.  
  540.  
  541.  
  542. '============================ DISPLAY FILES IN CURRENT DIR ===============
  543.  
  544. IF NOT skip1 THEN     ' bypass if default drive not ready
  545.  REDIM Text$(1 TO 1)  ' clear the array
  546.  GOSUB XtractFileNames     ' go get file names
  547. END IF ' end of bypass if default drive not ready
  548.  
  549. ' open a window for the files
  550. ' i'll omit error checking since all parms are static
  551. fil = OpenScrollWindow(7, 10, 22, 32, -9, 15, 1, 15, Text$(), 2, 3, 14, 19, 0, -1)
  552. x = ShowTitle("SELECT FILES", 14, 9)
  553.  
  554. ERASE Text$    ' save string memory until needed
  555.  
  556. '============================ DISPLAY CURRENT PATH =======================
  557.      
  558. pa = BlankWin(1, 10, 6, 46, -9, 15, 1, 15, 0, -1)
  559. a$ = DefaultDisk$ + ":" + DefaultDir$  ' build current path string
  560. x = ShowTitle("PATH", 14, 9)
  561. pathn = MakeInputField(1, 2, 33, a$, 15, 1)
  562. cd = MakePushButton(3, 3, 9, "Chg Dir", 15, 4, 1)
  563. ggo = MakePushButton(3, 14, 4, "GO", 15, 4, 1)
  564. quit = MakePushButton(3, 20, 6, "EXIT", 15, 4, 1)
  565.  
  566.  
  567. PALETTE 4, 4   ' reset attribute 4 (instructions at bottom of menu will
  568.                ' now be shown over a red background)
  569.  
  570. '===================== main loop =======================
  571.  
  572. DO
  573.   wn = WinEvent(action) ' wait for an event
  574.  
  575.     SELECT CASE wn    ' which window caused the event?
  576.   
  577.   
  578.     CASE drv   ' drives window caused the event
  579.         ' save index of text line with focus.
  580.         ' it is equivalent to logical drive number (A=1, B=2, etc)
  581.         dnum = WinParms(CurWinPtr, 15)    ' get index of text line with focus
  582.         dlett$ = CHR$(ASC("A") - 1 + dnum)  ' convert to a letter
  583.      
  584.  
  585.         ' if system has only one floppy, and either A: or B: was selected,
  586.         ' make that logical drive active to avoid the dos "insert diskette"
  587.         ' message when attempting to do I/O to an inactive logical floppy.
  588.         ' (OneFlop global variable is defined in the main module).
  589.  
  590.         IF OneFlop THEN      ' only one floppy on system?
  591.             IF dlett$ = "A" THEN    ' was A: selected ?
  592.                 DEF SEG = 0
  593.                 flopsav = PEEK(&H504)  ' save original
  594.                 POKE &H504, 0       ' set A: active
  595.                 DEF SEG
  596.             ELSEIF dlett$ = "B" THEN  ' else was b: selected ?
  597.                 DEF SEG = 0
  598.                 flopsav = PEEK(&H504)  ' save original
  599.                 POKE &H504, 1        ' set B: active
  600.                 DEF SEG
  601.             END IF
  602.         END IF
  603.      
  604.      
  605.         ' now, let's make sure selected drive is ready.
  606.         ' if not, i'll display an error window.
  607.         ' if the drive is ready, then ChangeDrive will be used
  608.         ' to make it current. however,
  609.         ' before making the selected drive current with ChangeDrive,
  610.         ' use GetCurDir$ to see if it's ready
  611.         ' (by getting current dir on that drive).
  612.         ' ChangeDrive will successfully change to a logical drive, even if
  613.         ' it's not ready. so, we need something to actually attempt to read
  614.         ' from the drive to see if it's ready. GetCurDir$ will do this and
  615.         ' detect if it's ready or not. if not ready, DOS will trap the
  616.         ' error and transfer to the error routine in the main module
  617.         ' (as long as we've executed an ON ERROR GOTO xxx statement there).
  618.  
  619.         ' if drive is not ready, error routine
  620.         ' will get control, open a window, and give the user two choices:
  621.         ' RETRY or IGNORE. The RETRY will cause a RESUME to be executed.
  622.         ' this returns control to the same statement that caused the error
  623.         ' (GetCurDir$) and it will be executed again.
  624.         ' the IGNORE will cause a RESUME NEXT to be executed. this
  625.         ' returns control to the statement AFTER the GetCurDir$ command that
  626.         ' caused the error.
  627.  
  628.         ' by initializing a$ to "not ready", we can tell
  629.         ' if GetCurDir$ was executed and if it was successful.
  630.         ' when GetCurDir$ is executed, it returns a value that will be
  631.         ' placed into a$. Thus, if a$ changes from "not ready",
  632.         ' then we know GetCurDir$ was executed.
  633.         ' if drive was not ready, and
  634.         ' user selected IGNORE, then the RESUME NEXT will cause
  635.         ' the GetCirDir$ statement to be skipped, and a$ will
  636.         ' still be set to "not ready".
  637.         ' in this case, we won't attempt to change to the selected drive.
  638.    
  639.         ' if a$ is something other than "not ready", then
  640.         ' i'll assume GetCurDir$ was successful (not necessarily a valid
  641.         ' assumption, you should check for error codes that could
  642.         ' be returned from GetCurDir$).
  643.  
  644.         ignor = 1  ' set flag to display the ignore button in drive not ready win
  645.         a$ = "NOT READY"  ' initialize a$
  646.         a$ = GetCurDir$(dlett$)  ' if successful, a$ will be the dir
  647.         ignor = 0   ' reset flag
  648.  
  649.         ' if successfully able to get current dir on new drive,
  650.         ' then a$ will no longer be set to "not ready". in this case,
  651.         ' change to new drive, get dirs and files, and show them in windows
  652.     
  653.         IF a$ <> "NOT READY" THEN
  654.             ' drive is ready
  655.             x = ChangeDrive(dlett$)' change to new drive
  656.             IF x < 0 THEN END  ' error not likely since prev GetCurDir was ok
  657.             GOSUB ShowNewStuff ' refresh dir, files, & path wins
  658.         ELSE
  659.             ' drive is not ready
  660.             ' if single floppy system & drive A/B, reset active floppy
  661.             IF OneFlop AND (dlett$ = "A" OR dlett$ = "B") THEN
  662.                 DEF SEG = 0
  663.                 POKE &H504, flopsav  ' restore orig value
  664.                 DEF SEG
  665.             END IF
  666.         END IF
  667.      
  668.  
  669.  
  670.     CASE dirs  ' dir window caused the event
  671.         ' new dir was selected.
  672.         ' must update the dir, files, and path windows
  673.      
  674.         ' get the name of dir selected (ie with focus)
  675.         ' from the text array displayed in the dir window.
  676.         i = WinParms(CurWinPtr, 18)    ' slot of text for this window
  677.         j = WinParms(CurWinPtr, 15)    ' entry with focus
  678.         a$ = SaveText(i, j)    ' line of text with focus (ie dir name)
  679.        
  680.         ' bypass if dir name was dot (.); we're already there
  681.         ' bypass if special names: <NONE> or (Incomplete List)
  682.         IF a$ <> "." AND a$ <> "<NONE>" AND a$ <> "(Incomplete List)" THEN
  683.             dlett$ = GetCurDrive$  ' in case not ready will have drive letter
  684.             x = 1234 ' set to value never returned by ChangeDir
  685.             ignor = 1  ' flag to display ignore button if disk not ready
  686.             x = ChangeDir(a$)      ' make that dir current
  687.             ' ChangeDir() will cause i/o to defualt drive.
  688.             ' not ready condition will be detected and processed by error
  689.             ' routine in main module. if IGNORE selected, x will remain set
  690.             ' to 1234.
  691.             ignor = 0  ' reset flag
  692.            
  693.             ' bypass if drive was not ready and ignore button selected
  694.             IF x <> 1234 THEN     ' if x is 1234, drive was not ready
  695.                 IF x < 0 THEN END ' errors not likely since choice was from list
  696.                 GOSUB ShowNewStuff   ' call sub to refresh dir, files, and path wins
  697.             END IF
  698.         END IF
  699.  
  700.  
  701.     CASE fil   ' files window caused the event
  702.      
  703.         ' lets get the name of file selected (ie with focus)
  704.         ' from the text array displayed in the files window.
  705.         i = WinParms(CurWinPtr, 18)    ' slot of text for this window
  706.         j = WinParms(CurWinPtr, 15)    ' entry with focus
  707.         a$ = SaveText(i, j)    ' line of text with focus
  708.           
  709.         ' bypass if special names:
  710.         ' <NONE> or (Incomplete List)
  711.         IF a$ <> "<NONE>" AND a$ <> "(Incomplete List)" THEN
  712.             'toggle selection character
  713.             IF MID$(a$, 2, 1) = "X" THEN
  714.                 MID$(a$, 2, 1) = " " ' un-select
  715.             ELSE
  716.                 MID$(a$, 2, 1) = "X"  ' select
  717.             END IF
  718.             SaveText(i, j) = a$
  719.             CALL ReShowText               ' re-display text in win
  720.         END IF
  721.  
  722.     CASE pa    ' pathname window
  723.         ' only action is the change path button
  724.         IF action = 3 THEN
  725.           SELECT CASE WinParms(CurWinPtr, 16)  ' select button
  726.  
  727.           CASE ggo         ' go process selected files
  728.            
  729.             ' first make sure that contents of input field on screen
  730.             ' is indeed the current dir.
  731.             ' if not, user probably made a change to the input field,
  732.             ' and hit the GO button instead of the Chg Dir button
  733.            
  734.             ' get current drive and dir
  735.             dlett$ = GetCurDrive$    ' get current drive
  736.             ignor = 1                ' ignore button displayed if not ready
  737.             cdir$ = "NOT READY"      ' set a default value
  738.             cdir$ = GetCurDir$("")   ' get current dir
  739.             ignor = 0                ' reset flag to display IGNORE button
  740.             skip1 = FALSE            ' initialize flag used to skip processing
  741.                                      ' when current drive is not ready and
  742.                                      ' IGNORE clicked
  743.             ' if cdir$ remains set to "NOT READY", then current drive
  744.             ' was not ready and user selected IGNORE.
  745.             ' in this case, set flag so further processing will be skipped
  746.             IF cdir$ = "NOT READY" THEN skip1 = TRUE
  747.             
  748.            
  749.             Fqual$ = dlett$ + ":" + cdir$    ' build full qualifier
  750.             ' we now have current drive and dir, compare to input field
  751.             ' (bypass this test if drive was not ready and ignore selected)
  752.             
  753.             IF Fqual$ <> ButtonsText(pathn) AND NOT skip1 THEN
  754.                 '  current path <> input field on screen
  755.                 BEEP
  756.                 y = BlankWin(6, 1, 17, 57, 4, 15, 1, 15, 0, 2)
  757.                 ' display message with reason
  758.                 y = ShowWinText(2, 2, 15, "Ambiguous path name detected - files NOT processed.")
  759.                 y = ShowWinText(3, 2, 15, "Above path does not match current drive & dir:")
  760.                 y = ShowWinText(4, 2, 14, Fqual$)
  761.                 y = ShowWinText(6, 2, 15, "If necessary, use the Chg Dir button to change paths.")
  762.                 y = ShowWinText(7, 2, 15, "Then use the GO button to process selected files.")
  763.                 y = MakePushButton(9, 7, 4, "OK", 15, 3, 1)
  764.                 y = WinEvent(z)  ' wait for any event
  765.                 y = CloseWindow
  766.                 skip1 = TRUE       ' set bypass flag
  767.             END IF
  768.            
  769.  
  770.             ' ----- process all files selected -------------
  771.             ' processing will be bypassed if current drive was not ready
  772.             ' and user clicked IGNORE (in this case, skip1 will be TRUE).
  773.             IF NOT skip1 THEN
  774.             
  775.              ' add trailing \ to fully qualified path if not root
  776.              IF cdir$ <> "\" THEN Fqual$ = Fqual$ + "\"
  777.             
  778.              ' build an array with file names that were selected
  779.              REDIM Text$(1 TO MaxTextLines)
  780.              x = IsWinOpen(fil, fhan) ' we know win # (fil), get handle (fhan)
  781.              slot = WinParms(fhan, 18)  ' slot of text for this window
  782.              ' scan text array, move all files marked with [X] to Text$
  783.              txtptr = 0      ' slot in Text$ to get entry
  784.              FOR j = 1 TO WinParms(fhan, 17)  ' scan text array
  785.                 ' find selected entries (will have [X] as 1st 3 characters)
  786.                 IF LEFT$(SaveText(slot, j), 3) = "[X]" THEN
  787.                     ' current entry in SaveText was selected
  788.                     lfil = LEN(SaveText(slot, j)) - 4  ' len of file name
  789.                     txtptr = txtptr + 1  ' bump pointer to next Text$ slot
  790.                     ' this condition should never occur - safety net
  791.                     IF txtptr > MaxTextLines THEN END
  792.                     ' move file name (without the [X]) to Text$ array
  793.                     Text$(txtptr) = RIGHT$(SaveText(slot, j), lfil)
  794.                 END IF
  795.              NEXT
  796.             
  797.              ' if no items selected in Text$, display error message
  798.              IF txtptr = 0 THEN
  799.                 BEEP
  800.                 y = BlankWin(17, 1, 24, 37, 4, 15, 1, 15, 0, 2)
  801.                 y = ShowWinText(2, 2, 15, "No files were selected.")
  802.                 y = MakePushButton(5, 7, 4, "OK", 15, 3, 1)
  803.                 y = WinEvent(z)  ' wait for any event
  804.                 y = CloseWindow
  805.              ELSE
  806.                 ' Text$ array has been built, go process its contents
  807.                 CALL ProcessFiles(Fqual$, Text$()) ' process selected files
  808.  
  809.                 ' now redisplay contents of files window.
  810.  
  811.                 ' we could just change the [X] to [ ] and
  812.                 ' redisplay the original list of file names.
  813.                 ' however, the processing performed in ProcessFIles
  814.                 ' could have changed the contents of the current directory
  815.                 ' (for example, the selected files could have been deleted).
  816.                 ' therefore, the current contents of the current directory
  817.                 ' are first determined (using GetFileNames), then displayed.
  818.                 REDIM Text$(1 TO 1)    ' clear the array
  819.                 GOSUB XtractFileNames  ' go get current file names
  820.                 CALL NewFocusWindow(fhan)  ' give focus to files window
  821.                 CALL RefreshScrollText(Text$())   ' redisplay new file list
  822.              END IF
  823.              ERASE Text$  ' clear array to save string memory
  824.             END IF   ' end of test to bypass
  825.  
  826.           CASE quit       ' quit
  827.             GOSUB CloseAll      ' go close all open windows
  828.             EXIT DO   ' bail out
  829.  
  830.           CASE cd          ' change dir
  831.             rr = ChgPath(ButtonsText(pathn))      ' go change path
  832.             SELECT CASE rr    ' test return code
  833.  
  834.             CASE -2           ' current drive is not ready
  835.                 cdir$ = "NOT READY"  ' current drive is not ready
  836.                 skip1 = TRUE   ' to skip display of dirs & files
  837.                 GOSUB ShowNewStuff1    ' go update path window
  838.            
  839.             CASE ELSE
  840.                 GOSUB ShowNewStuff    ' go update all windows
  841.  
  842.             END SELECT   ' end of select for change path
  843.  
  844.          
  845.           END SELECT   ' end of select button in path win
  846.  
  847.         END IF   ' end of code to process action in path name window
  848.  
  849.  
  850.     END SELECT
  851.  
  852.  
  853. LOOP   ' continue until main window is closed
  854.  
  855.  
  856. EXIT SUB
  857.  
  858. '=======================================================
  859. ' sub to re-display current sub-dirs, files, and path.
  860. ' called when change made in directory, drive, or path window
  861. ' (after appropriate drive and/or dir has been made current).
  862.  
  863. ShowNewStuff:
  864.  
  865. dlett$ = GetCurDrive$    ' just in case not ready condition
  866. ignor = 1                ' ignore option displayed
  867. cdir$ = "NOT READY"
  868. cdir$ = GetCurDir$("")
  869. ignor = 0                        ' reset flag
  870.  
  871. skip1 = FALSE    ' flag to skip display of dirs & files windows
  872. IF cdir$ = "NOT READY" THEN skip1 = TRUE  ' set skip flag if drive not ready
  873.  
  874.  
  875. ' second entry point - called if drive specified in input field was current
  876. '                      and it was not ready. no need to check current drive's
  877. '                      readiness again.
  878. ShowNewStuff1:
  879.  
  880.  
  881. ' ========== DIRS ==================
  882. ' get new list of sub-dirs in current dir and redisplay then
  883. REDIM Text$(1 TO 1)  ' clear the array
  884.  
  885. IF NOT skip1 THEN     ' bypass if default drive not ready
  886.     GOSUB XtractSubDirs   ' go get sorted list of sub-dirs
  887. END IF    ' end of bypass in default drive not ready
  888.  
  889. x = IsWinOpen(dirs, wh)   ' get handle of dirs window
  890. CALL NewFocusWindow(wh)  ' make it current
  891. CALL RefreshScrollText(Text$())   ' redisplay new dir list
  892.  
  893.  
  894.  
  895. ' ============== FILES ==============
  896.  
  897. IF NOT skip1 THEN    ' bypass if default drive not ready
  898.  REDIM Text$(1 TO 1)  ' clear the array
  899.  GOSUB XtractFileNames  ' get file names
  900. END IF ' end of bypass if defualt drive not ready
  901.  
  902. x = IsWinOpen(fil, wh)   ' get handle of files window
  903. CALL NewFocusWindow(wh)  ' make it current
  904. CALL RefreshScrollText(Text$())   ' redisplay new file list
  905. ERASE Text$  ' save string memory
  906.  
  907.  
  908. ' =========== PATH ==============
  909.  
  910. ' if selected path refs a drive that's not ready,
  911. ' and user selects IGNORE, then we must reset path input field to current
  912. ' path (otherwise, it will contain the not ready drive
  913. ' which could confuse the user since file and dir windows still have
  914. ' data from current path).
  915.  
  916. ' make the path window current
  917. x = IsWinOpen(pa, wh)   ' get handle of window
  918. CALL NewFocusWindow(wh)  ' make it current
  919. a$ = dlett$ + ":" + cdir$  ' build path string
  920. ButtonsText(pathn) = a$  ' set to new path
  921. ReShowInputField (pathn)' redisplay input field
  922.  
  923. RETURN
  924.  
  925.  
  926. '=========================================================
  927. '             close all open files
  928. CloseAll:
  929.  
  930. ' reset palette for wallpaper window so it looks blue
  931. ' during closure of other windows
  932. PALETTE 4, 57   ' change color of wallpaper win to blue
  933.                 ' while over-laying windows are closed
  934.                 ' (to minimize visual impact). will be changed back later
  935.  
  936. ' close the windows with numbers: pa, fil, dirs, drv, wal
  937.            
  938. IF IsWinOpen(pa, Han) THEN   ' get handle
  939.     CALL NewFocusWindow(Han)  ' if open, make win active
  940.     x = CloseWindow           ' close it
  941. END IF
  942.  
  943. IF IsWinOpen(fil, Han) THEN    ' get handle
  944.     CALL NewFocusWindow(Han)  ' if open, make win active
  945.     x = CloseWindow           ' close it
  946. END IF
  947.  
  948. IF IsWinOpen(dirs, Han) THEN   ' get handle
  949.     CALL NewFocusWindow(Han)  ' if open, make win active
  950.     x = CloseWindow           ' close it
  951. END IF
  952.  
  953. IF IsWinOpen(drv, Han) THEN   ' get handle
  954.     CALL NewFocusWindow(Han)  ' if open, make win active
  955.     x = CloseWindow           ' close it
  956. END IF
  957.  
  958. IF IsWinOpen(wal, Han) THEN   ' get handle
  959.     CALL NewFocusWindow(Han)  ' if open, make win active
  960.     x = CloseWindow           ' close it
  961. END IF
  962.  
  963. ' reset palette back to red
  964. PALETTE 4, 4
  965.  
  966. RETURN
  967.  
  968.  
  969. '===================================================================
  970. '           get sub-dirs, place into Text$, and sort
  971. XtractSubDirs:
  972.  
  973. ' get any sub-directories in current directory
  974. x = GetFileNames(1, "*.*", Text$())
  975. zer = OutRegs.ax   ' save in case an unknown error occured
  976. ' test for errors
  977. IF x < 0 THEN
  978.    SELECT CASE x
  979.    CASE -2   ' no matches
  980.         Text$(1) = "<NONE>"
  981.    CASE ELSE
  982.         ' except for the case where there are no dirs (-2 case),
  983.         ' i'll leave error checking to you.
  984.         ' other errors are straight forward. once your code is debugged,
  985.         ' they should not occur.
  986.        BEEP
  987.        z = BlankWin(14, 6, 21, 52, 5, 15, 1, 15, 0, 2)
  988.        z = ShowWinText(2, 4, 15, "Unknown error reading sub-dirs: " + STR$(zer))
  989.        z = MakePushButton(4, 14, 4, "OK", 15, 3, 1)
  990.        z = WinEvent(w)  ' wait for any action
  991.        z = CloseWindow
  992.        GOSUB CloseAll        ' close all open windows
  993.        EXIT SUB   ' bail out
  994.    END SELECT
  995. END IF
  996. CALL SortIt(Text$())    ' sort the dirs
  997. RETURN
  998.  
  999.  
  1000. '=================================================================
  1001. '        get file names, prefix with [ ], place into Text$, sort
  1002. XtractFileNames:
  1003.  
  1004. ' get files in current directory
  1005. x = GetFileNames(2, "*.*", Text$())
  1006. zer = OutRegs.ax   ' save in case an unknown error occured
  1007. ' insert [ ] in front of file names
  1008. FOR i = LBOUND(Text$) TO UBOUND(Text$)
  1009.  IF LEN(Text$(i)) > 0 THEN Text$(i) = "[ ] " + Text$(i)
  1010. NEXT
  1011. ' test for errors
  1012. IF x < 0 THEN
  1013.    SELECT CASE x
  1014.    CASE -2   ' no matches
  1015.         Text$(1) = "<NONE>"
  1016.    CASE ELSE
  1017.         ' except for the case where there are no files (-2 case),
  1018.         ' i'll leave error checking to you.
  1019.         ' other errors are straight forward. once your code is debugged,
  1020.         ' they should not occur.
  1021.        BEEP
  1022.        z = BlankWin(14, 6, 21, 52, 5, 15, 1, 15, 0, 2)
  1023.        z = ShowWinText(2, 4, 15, "Unknown error reading files: " + STR$(zer))
  1024.        z = MakePushButton(4, 14, 4, "OK", 15, 3, 1)
  1025.        z = WinEvent(w)  ' wait for any action
  1026.        z = CloseWindow
  1027.        GOSUB CloseAll        ' close all open windows
  1028.        EXIT SUB              ' bail out
  1029.    END SELECT
  1030. END IF
  1031. CALL SortIt(Text$())    ' sort the files
  1032. RETURN
  1033.  
  1034.  
  1035. END SUB
  1036.  
  1037. SUB Main
  1038.  
  1039. ' this subroutine will open a window, display a GO button and the current
  1040. ' directory's name. clicking the GO button will give control to the
  1041. ' DoFiles subroutine which will open several windows:
  1042. ' directory, drive, and files.
  1043. ' while these windows are visible, you will be able to change the current
  1044. ' directory or drive (and the corresponding files will be displayed).
  1045.  
  1046. ' note the technique used to determine if the default drive is not ready.
  1047.  
  1048. ' the variable used to save the current directory's name (DefaultDir$) is set
  1049. ' to a default value. a flag (ignor) is set so the IGNORE button will be
  1050. ' displayed in an error window if a "not ready" condition occurs.
  1051. ' the GetCurDir$ function is called to get the current directory's name.
  1052. ' this causes i/o to the default drive (note that GetCurDrive$ will NOT
  1053. ' cause i/o to the current drive, DOS maintains the current drive's
  1054. ' designation internally so i/o is not necessary).
  1055.  
  1056. ' if the drive is not ready, the error routine (defined in the main module)
  1057. ' will get control. the error routine tests for a not ready condition and
  1058. ' if that condition caused the error, a window is opened. the window
  1059. ' will have a RETRY button, and if the ignor flag is 1, it will also
  1060. ' have an IGNORE button.
  1061.  
  1062. ' if RETRY is selected, control is returned to the GetCurDir$ function
  1063. ' (the current directory's name is returned and saved in
  1064. ' the variable DefaultDir$). if the IGNORE button is clicked, then control
  1065. ' is returned to the instruction after the call to GetCurDir$, and the
  1066. ' the DefaultDir$ variable will retain it's original value.
  1067.  
  1068. ' thus, by comparing the DefaultDir$ variable to its default setting,
  1069. ' you can determine if the drive was not ready and IGNORE selected.
  1070.  
  1071.  
  1072. DefaultDisk$ = GetCurDrive$  ' get current drive's letter
  1073. dlett$ = DefaultDisk$        ' dlett$ variable is used by error routine
  1074. DefaultDir$ = "NOT READY"    ' set default
  1075. ignor = 1                    ' set flag: IGNORE button will be visible
  1076. DefaultDir$ = GetCurDir$("") ' error window will be open if drive not ready
  1077. ignor = 0                    ' reset flag: IGNORE button not displayed
  1078.  
  1079. ' if current drive was not ready, and IGNORE button clicked,
  1080. ' then the DefaultDir$ variable will still contain the
  1081. ' default string "NOT READY". compare to see if not ready error occured.
  1082. ' in that case (default drive not ready), display window and exit.
  1083. IF DefaultDir$ = "NOT READY" THEN
  1084.     BEEP
  1085.     bail1 = BlankWin(3, 1, 10, 43, 9, 15, 1, 15, 0, 2)
  1086.     x = ShowWinText(2, 2, 15, "Default drive could not be made ready")
  1087.     x = ShowWinText(3, 2, 15, "Program terminating ...")
  1088.     ok1 = MakePushButton(5, 7, 6, "BYE!", 15, 4, 1)
  1089.     wn = WinEvent(action)' wait
  1090.     x = CloseWindow      ' any action - close
  1091.     EXIT SUB
  1092. END IF
  1093.  
  1094. ' main window
  1095. tr = 1   'top row
  1096. tc = 3   'top col
  1097. br = 9   'bottom row
  1098. bc = 60  'bottom col
  1099.  
  1100. ' open a window to contain the current directory's name and a GO button
  1101. main1 = BlankWin(tr, tc, br, bc, 3, 15, 2, 15, 0, 1)
  1102.  
  1103. x = MakeHorizLine(4, 2)       ' horizontal line
  1104. x = ShowWinText(5, 2, 15, "Current directory:") ' label for dir's name
  1105.  
  1106. ' the current directory's name could now be displayed using a
  1107. ' call to ShowWinText. however, the current dir name can be changed
  1108. ' dynamically (via the DoFiles subroutine that is called by clicking
  1109. ' the GO button). thus, upon return from DoFiles, we need a technique
  1110. ' for changing the text that shows the current directory's name.
  1111.  
  1112. ' this could be done by calling ShowWinText to display the current dir's
  1113. ' name "over" the text with the old dir name. however,
  1114. ' each call to ShowWinText uses a unique handle to access LangWin's data
  1115. ' structures (the global MaxButtons defines the maximum number of handles).
  1116. ' since the new dir name is displayed "over" the old name, there's really
  1117. ' no reason for using up a new handle for the new dir name. we need a way to
  1118. ' "reuse" the same handle to save the dir name's text and then display it.
  1119.  
  1120. ' to accomplish this (ie, to reuse the existing handle), we must first
  1121. ' determine what the handle number is. ShowWinText does NOT return a handle
  1122. ' value, so we must figure out what the handle number is before we can
  1123. ' reuse it. this can be done by first using ShowWinText to create text with a
  1124. ' known value. then, by scanning LangWin's data structure
  1125. ' (ie the ButtonsText() array) for that known value, the handle
  1126. ' number can be determined. thereafter, the ReShowInputField(handle)
  1127. ' can be used to redisplay the text (after changing its value
  1128. ' in ButtonsText(handle) to the new dir's name).
  1129.  
  1130. x = ShowWinText(6, 2, 14, "KNOWN VALUE")   ' define specific text
  1131. ' now scan all button text to find handle of above text
  1132. cdnam = -999               ' default handle number
  1133. FOR i = 1 TO MaxButtons    ' scan the entire data structure
  1134.     IF ButtonsText(i) = "KNOWN VALUE" THEN    ' look for specific text
  1135.         cdnam = i                             ' if match, save handle
  1136.         EXIT FOR                              ' terminate search
  1137.     END IF
  1138. NEXT
  1139. ' see if we have a serious problem, could not find specific text
  1140. IF cdnam = -999 THEN
  1141.     CLS
  1142.     BEEP
  1143.     PRINT "INTERNAL ERROR"
  1144.     PRINT "COULD NOT FIND HANDLE FOR SPECIFIC TEXT"
  1145.     END
  1146. END IF
  1147.  
  1148. ' at this point, cdnam contains handle where current dir name is saved
  1149. a$ = DefaultDisk$ + ":" + DefaultDir$ ' fully qualified dir name
  1150. ButtonsText(cdnam) = a$   ' update value in data structure
  1151. CALL ReShowInputField(cdnam)  ' redisplay the dir name
  1152. ButtonsData(cdnam, 4) = LEN(a$)  ' update length of area
  1153.  
  1154.  
  1155. ggo = MakePushButton(2, 2, 4, "GO", 15, 5, 1)
  1156. quit = MakePushButton(2, 30, 6, "QUIT", 15, 5, 1)
  1157.  
  1158. x = ShowTitle(" SAMPLE04 ", 3, 15)' place this last so title will be
  1159.                                   ' preserved if window is resized
  1160.  
  1161.  
  1162.  
  1163. '==========  MAIN LOOP ========================================
  1164.  
  1165. DO WHILE AnyWinOpen
  1166.   wn = WinEvent(action) ' wait for an event
  1167.  
  1168.   SELECT CASE wn    ' which window caused the event?
  1169.  
  1170.   CASE main1
  1171.     ' only buttons exist
  1172.     IF action = 3 THEN
  1173.         ' process the button
  1174.         SELECT CASE WinParms(CurWinPtr, 16) ' select button handle
  1175.        
  1176.         CASE ggo
  1177.           ' first, change mode of main win to wallpaper
  1178.           ' this will prevent selection of this win while the
  1179.           ' multiple windows opened in DoFiles are visible
  1180.             
  1181.           ' get handle of window whose number is main1, save in main1han
  1182.           ' (it's open at this point, no need to test return code)
  1183.           x = IsWinOpen(main1, main1han)
  1184.           zz = WinParms(main1han, 19)' save mode of main win
  1185.           WinParms(main1han, 19) = 4  ' set mode of main win to wallpaper
  1186.           CALL DoFiles
  1187.           WinParms(main1han, 19) = zz   ' restore original mode
  1188.  
  1189.           ' now redisplay the current dir name (which could have
  1190.           ' been changed while in DoFiles) using the original handle
  1191.           ' (saved in cdnam).
  1192.  
  1193.           ' get current disk letter and directory
  1194.           dlett$ = GetCurDrive$   ' variable used by error routine
  1195.           ignor = 0               ' set flag to hide IGNORE button.
  1196.                                   ' (ignoring a not ready condition on the
  1197.                                   ' default drive upon returning from
  1198.                                   ' DoFiles will not be an option).
  1199.           cdir$ = GetCurDir$("")  ' get current dir name
  1200.           cd$ = dlett$ + ":" + cdir$    ' build fully qualified dir name
  1201.           ButtonsText(cdnam) = cd$ ' update data structure
  1202.           ReShowInputField (cdnam) ' redisplay current dir name
  1203.           ButtonsData(cdnam, 4) = LEN(cd$) 'update length
  1204.  
  1205.         CASE quit
  1206.             ' open modal window with no close icon
  1207.             clos = BlankWin(1, 1, 7, 31, 4, 15, 1, 15, 0, 2)
  1208.             x = ShowWinText(2, 2, 15, "Do you really want to quit?")
  1209.             quity1 = MakePushButton(4, 7, 5, "YES", 15, 3, 1)
  1210.             quitn1 = MakePushButton(4, 19, 4, "NO", 15, 3, 1)
  1211.             ' make "no" the default button
  1212.             WinParms(CurWinPtr, 16) = quitn1 ' put handle in data structure
  1213.             CALL ChangeButtonFocus(quitn1, 0) ' redisplay button with reverse video
  1214.        
  1215.         END SELECT
  1216.    
  1217.     END IF   ' end of code for main1 window
  1218.  
  1219.   CASE clos  ' modal win asking if user really wants to quit
  1220.     ' only action that could occur is button press
  1221.     IF action = 3 THEN   'but just in case, lets check the action
  1222.         SELECT CASE WinParms(CurWinPtr, 16)  ' handle of button clicked
  1223.         CASE quity1    ' yes button
  1224.             ' following code is not technically necessary,
  1225.             ' you could just EXIT DO here, and return
  1226.             ' to the calling program (if you know that
  1227.             ' all the calling program will do is exit).
  1228.             ' however, if calling program will do other tasks,
  1229.             ' we must close all open windows before leaving, so ...
  1230.                
  1231.             xx = CloseWindow' close the current win
  1232.                
  1233.             ' now close all other windows
  1234.                
  1235.             ' scan WinStack backwards, get win handle,
  1236.             ' make it active, then close it
  1237.             FOR i = LastWinStack TO 1 STEP -1
  1238.                 CALL NewFocusWindow(WinStack(i))  ' make win active
  1239.                 x = CloseWindow                   ' close it
  1240.             NEXT
  1241.             EXIT DO   ' bail out
  1242.            
  1243.         CASE quitn1    ' no button in close warning window
  1244.             ' user changed their mind, just close the current window
  1245.             xx = CloseWindow
  1246.  
  1247.         END SELECT
  1248.     END IF    ' end of code for clos window
  1249.  
  1250.  
  1251.   END SELECT  ' end of code to process window numbers
  1252.  
  1253. LOOP
  1254.  
  1255. ' now restore original drive & dir
  1256.  
  1257. ' first restore dir.
  1258. ' then if it's not ready and ignore button clicked,
  1259. ' we can skip restoring the drive.
  1260.  
  1261. dlett$ = DefaultDisk$  ' needed by error routine
  1262. ignor = 1              ' flag to display IGNORE button
  1263. x = 1234               ' set default as a return code never used by ChangeDir
  1264. ' ChangeDir() will cause i/o to defualt drive.
  1265. ' not ready condition will be detected and processed by error routine
  1266. ' in main module. if IGNORE selected, x will remain set to 1234.
  1267. x = ChangeDir(DefaultDisk$ + ":" + DefaultDir$)  ' fully qualified
  1268. IF x <> 1234 THEN  ' if x is still 1234, a not ready condition occured
  1269.     ' not ready condition did not occur
  1270.     ' so restore original drive
  1271.     IF x < 0 THEN END    'error not likely since Default Dir exists
  1272.     x = ChangeDrive(DefaultDisk$)
  1273.     IF x < 0 THEN END    ' drive error not likely since above change dir
  1274.                          ' was successful
  1275. END IF
  1276.  
  1277. EXIT SUB   ' bail out
  1278.  
  1279.  
  1280. END SUB
  1281.  
  1282. SUB ProcessFiles (Qual$, Text$())
  1283.  
  1284. ' this is where you would place the code to process
  1285. ' all selected files.
  1286.  
  1287. '   Qual$ -   contains the fully qualified path (drive & dir) for the files
  1288. '   Text$() - contains the files selected
  1289.  
  1290. ' in this sample, i'll just open a window and display the
  1291. ' fully qualified names of all selected files
  1292.  
  1293. ' add fully qualified path to file name
  1294. FOR i = LBOUND(Text$) TO UBOUND(Text$)
  1295.     ' only modify non-null entries
  1296.     IF LEN(Text$(i)) > 0 THEN Text$(i) = Qual$ + Text$(i)
  1297. NEXT
  1298.  
  1299.  
  1300. ' open window to scroll file names
  1301.  
  1302. hr1 = 1    ' start row
  1303. hc1 = 1    ' start col
  1304. hr2 = 18   ' end row
  1305. hc2 = 56   ' end col
  1306. hh = OpenScrollWindow(hr1, hc1, hr2, hc2, 2, 15, 2, 15, Text$(), 2, 2, hr2 - hr1 - 2 - 2, hc2 - hc1 - 2, 0, 2)
  1307. x = MakeHorizLine(hr2 - hr1 - 3, 2)
  1308. x = MakePushButton(hr2 - hr1 - 2, (hc2 - hc1) \ 2 - 2, 4, "OK", 15, 4, 1)
  1309. x = ShowTitle(" SELECTED FILES ", 2, 15)
  1310. DO
  1311.     x = WinEvent(aa)   ' wait for any event
  1312. LOOP WHILE aa = 2 ' loop if event was double click on text (aa=2)
  1313.                   ' exit loop if event was ESC key (aa=1) or OK button (aa=3)
  1314. x = CloseWindow   ' close
  1315.  
  1316. END SUB
  1317.  
  1318. SUB SortIt (s$())
  1319.  
  1320. ' simple bubble sort - sort contents of s$ in ascending order
  1321.  
  1322. strt = LBOUND(s$)' starting index
  1323. en = UBOUND(s$)' ending index
  1324.  
  1325.  
  1326. ' first scan backwards til first non-null entry.
  1327. ' no need to sort them.
  1328.  
  1329. en1 = strt      ' default value in case all entries are null
  1330. FOR i = en TO strt STEP -1
  1331.     IF s$(i) <> "" THEN  ' look for null
  1332.         en1 = i          ' save new ending index
  1333.         EXIT FOR         ' stop scan
  1334.     END IF
  1335. NEXT
  1336.  
  1337. ' if either 1 or no non-null entries, no need to sort
  1338. IF en1 = strt THEN EXIT SUB
  1339.  
  1340. ' do the sort
  1341. FOR i = strt TO en1 - 1
  1342.     FOR j = i + 1 TO en1
  1343.         IF s$(j) < s$(i) THEN SWAP s$(j), s$(i)
  1344.     NEXT
  1345. NEXT
  1346.  
  1347.  
  1348.  
  1349.  
  1350. END SUB
  1351.  
  1352. ' =====================================================
  1353. '  returns type of video display
  1354. '
  1355. '  return values:
  1356. '       1:  black/white    (could be EGA/VGA with monochrome)
  1357. '       2:  CGA   (with color)
  1358. '       3:  EGA   (with color)
  1359. '       4:  VGA   (with color)
  1360. '       5:  MCGA  (with color)
  1361. '      99:  other
  1362. '
  1363. FUNCTION VidType
  1364.  
  1365. ' quick & dirty, check &h463
  1366. DEF SEG = 0
  1367. IF PEEK(&H463) = &HB4 THEN     ' see if monochrome
  1368.     VidType = 1
  1369.     EXIT FUNCTION
  1370. END IF
  1371. DEF SEG
  1372.  
  1373. ' first try int 10h, function 1Ah
  1374.  
  1375. InRegs.ax = &H1A00
  1376. CALL INTERRUPTX(&H10, InRegs, OutRegs)
  1377. IF (OutRegs.ax AND &HFF) = &H1A THEN    ' see if int 10h, funct 1Ah supported
  1378.     code = (OutRegs.bx AND &HFF)  ' get display code
  1379.     SELECT CASE code
  1380.     CASE 1      ' MDA
  1381.         VidType = 1
  1382.     CASE 2      ' CGA
  1383.         VidType = 2
  1384.     CASE 4      ' EGA color
  1385.         VidType = 3
  1386.     CASE 5      ' EGA b/w
  1387.         VidType = 1
  1388.     CASE 7      ' VGA b/w
  1389.         VidType = 1
  1390.     CASE 8      ' VGA color
  1391.         VidType = 4
  1392.     CASE 10     ' MCGA color
  1393.         VidType = 5
  1394.     CASE 11     ' MCGA b/w
  1395.         VidType = 1
  1396.     CASE ELSE
  1397.         VidType = 99    ' other
  1398.     END SELECT
  1399.     EXIT FUNCTION
  1400.  
  1401. ELSE
  1402.     ' now try int 10h, function 12h, sub-function 10h
  1403.     InRegs.ax = &H1200
  1404.     InRegs.bx = &H10
  1405.     CALL INTERRUPTX(&H10, InRegs, OutRegs)
  1406.     IF (OutRegs.bx AND &HFF00) = 1 THEN     ' see if monochrome
  1407.         VidType = 1
  1408.         EXIT FUNCTION
  1409.     END IF
  1410.  
  1411.     IF (OutRegs.bx AND &HFF) <> &H10 THEN   ' see if BL reg changed
  1412.         VidType = 3    ' EGA (not sure why it couldn't be VGA too!)
  1413.         EXIT FUNCTION
  1414.     END IF
  1415.  
  1416.     VidType = 99      ' other (probably CGA or MDA)
  1417.  
  1418. END IF
  1419.  
  1420. END FUNCTION
  1421.  
  1422.